home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / linda-tabs.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  4KB  |  117 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;                                                                           ;;
  9. ;;   EuLisp Module  -   Copyright (C) Codemist and University of Bath 1989   ;;
  10. ;;                                                                           ;;
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ;;                                                                           ;;
  15. ;; Name: linda-tables                                                        ;;
  16. ;;                                                                           ;;
  17. ;; Author: Keith Playford                                                    ;;
  18. ;;                                                                           ;;
  19. ;; Date: 31 May 1990                                                         ;;
  20. ;;                                                                           ;;
  21. ;; Description: Basic IO for linda pool tuple spaces                         ;;
  22. ;;                                                                           ;;
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25. ;;
  26.  
  27. ;; Change Log:
  28. ;;   Version 1.0 (31/5/90)
  29.  
  30. ;;
  31.  
  32. (defmodule linda-tabs
  33.  
  34.   (lists
  35.    list-operators
  36.    extras
  37.    arith
  38.    classes
  39.    streams
  40.    ccc
  41.    tables
  42.    vectors
  43.    calls
  44.    others
  45.  
  46.    linda-base) ()
  47.  
  48.  
  49.   ;;
  50.  
  51.   ;; Note:
  52.  
  53.   ;;   Just a hack to begin with - going for an eq on name and equal on 
  54.   ;;   everything else to fit in with Dave's world of tuple vectors.
  55.  
  56.   ;;
  57.  
  58.   ;; Tuple table structure...
  59.  
  60.   (defstruct linda-tuple-table ()
  61.     ((table initform (make-table eq)
  62.         accessor tuple-table-table))
  63.     constructor make-linda-tuple-table)
  64.  
  65.   (export make-linda-tuple-table tuple-table-table)
  66.  
  67.   ;; Interface...
  68.  
  69.   (defun tuple-table-out (tuple-table tuple)
  70.     (let* ((tab (tuple-table-table tuple-table))
  71.        (key (linda-tuple-key tuple))
  72.        (set (table-ref tab key)))
  73.       ((setter table-ref) tab key (nconc set (list tuple)))
  74.       tuple))
  75.  
  76.   ;; Match from a set...
  77.  
  78.   (defun in-match-from (tuple ll)
  79.     (in-match-from-aux tuple ll nil))
  80.  
  81.   (defun in-match-from-aux (tuple ll prev)
  82.     (cond 
  83.       ((null ll) nil)
  84.       ((null (car ll)) (in-match-from-aux tuple (cdr ll) ll))
  85.       ((linda-tuple-matched-p tuple (car ll)) 
  86.         (let ((match (car ll)))
  87.       (if (null prev) 
  88.         ((setter car) ll nil)
  89.         ((setter cdr) prev (cdr ll)))
  90.        match))
  91.       (t (in-match-from-aux tuple (cdr ll) ll))))
  92.  
  93.   (defun tuple-table-in (tuple-table tuple)
  94.     (let* ((tab (tuple-table-table tuple-table))
  95.        (key (linda-tuple-key tuple))
  96.        (set (table-ref tab key)) ;; Assumes key can't be wildcard
  97.        (match (in-match-from tuple set)))
  98.       match))
  99.  
  100.   (defun read-match-from (tuple ll)
  101.     (cond 
  102.       ((null ll) nil)
  103.       ((null (car ll)) (read-match-from tuple (cdr ll)))
  104.       ((linda-tuple-matched-p tuple (car ll)) (car ll)) ;; Copy?
  105.       (t (read-match-from tuple (cdr ll)))))
  106.  
  107.   (defun tuple-table-read (tuple-table tuple)
  108.     (let* ((tab (tuple-table-table tuple-table))
  109.        (key (linda-tuple-key tuple))
  110.        (set (table-ref tab key)) ;; Assumes key can't be wildcard
  111.        (match (read-match-from tuple set)))
  112.       match))
  113.  
  114.   (export tuple-table-in tuple-table-read tuple-table-out)
  115.  
  116. )
  117.